home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / contrib / zelk / src-elk / load.c next >
Encoding:
C/C++ Source or Header  |  1992-11-13  |  3.0 KB  |  141 lines
  1. #include "scheme.h"
  2.  
  3. /* zelk needs these variables to be global */
  4. /*static*/ Object V_Load_Path, V_Load_Noisilyp, V_Load_Libraries;
  5.  
  6. #ifdef CAN_LOAD_OBJ
  7. #  define Default_Load_Libraries LOAD_LIBRARIES
  8. #else
  9. #  define Default_Load_Libraries ""
  10. #endif
  11.  
  12. #if defined(CAN_DUMP) || defined(USE_LD)
  13. char Loader_Input[20];
  14. #endif
  15.  
  16. #ifdef USE_LD
  17. #  include "load.ld.c"
  18. #else
  19. #ifdef USE_RLD
  20. #  include "load.rld.c"
  21. #else
  22. #ifdef USE_SHL
  23. #  include "load.shl.c"
  24. #endif
  25. #endif
  26. #endif
  27.  
  28. Init_Load () {
  29.     Define_Variable (&V_Load_Path, "load-path",
  30.     Cons (Make_String (".", 1),
  31.     Cons (Make_String (SCM_DIR, sizeof (SCM_DIR) - 1),
  32.     Cons (Make_String (LIB_DIR, sizeof (LIB_DIR) - 1), Null))));
  33.     Define_Variable (&V_Load_Noisilyp, "load-noisily?", False);
  34.     Define_Variable (&V_Load_Libraries, "load-libraries", 
  35.     Make_String (Default_Load_Libraries, sizeof Default_Load_Libraries-1));
  36. }
  37.  
  38. Init_Loadpath (s) char *s; {     /* No GC possible here */
  39.     register char *p;
  40.     Object path = Null;
  41.  
  42.     if (s[0] == '\0')
  43.     return;
  44.     while (1) {
  45.     for (p = s; *p && *p != ','; p++)
  46.         ;
  47.     path = Cons (Make_String (s, p-s), path);
  48.     if (*p == '\0')
  49.         break;
  50.     s = ++p;
  51.     }
  52.     Var_Set (V_Load_Path, path);
  53. }
  54.  
  55. Object Is_O_File (name) Object name; {
  56.     register char *p;
  57.     register struct S_String *str;
  58.  
  59.     if (TYPE(name) == T_Symbol)
  60.     name = SYMBOL(name)->name;
  61.     str = STRING(name);
  62.     p = str->data + str->size;
  63.     return str->size >= 2 && *--p == 'o' && *--p == '.';
  64. }
  65.  
  66. void Check_Loadarg (x) Object x; {
  67.     Object tail;
  68.     register t = TYPE(x);
  69.  
  70.     if (t == T_Symbol || t == T_String)
  71.     return;
  72.     if (t != T_Pair)
  73.     Wrong_Type_Combination (x, "string, symbol, or list");
  74.     for (tail = x; !Nullp (tail); tail = Cdr (tail)) {
  75.     Object f = Car (tail);
  76.     if (TYPE(f) != T_Symbol && TYPE(f) != T_String)
  77.         Wrong_Type_Combination (f, "string or symbol");
  78.     if (!Is_O_File (f))
  79.         Primitive_Error ("~s: not an object file", f);
  80.     }
  81. }
  82.  
  83. Object General_Load (what, env) Object what, env; {
  84.     Object oldenv;
  85.     GC_Node;
  86.  
  87.     Check_Type (env, T_Environment);
  88.     oldenv = The_Environment;
  89.     GC_Link (oldenv);
  90.     Switch_Environment (env);
  91.     Check_Loadarg (what);
  92.     if (TYPE(what) == T_Pair)
  93. #ifdef CAN_LOAD_OBJ
  94.     Load_Object (what)
  95. #endif
  96.     ;
  97.     else if (Is_O_File (what))
  98. #ifdef CAN_LOAD_OBJ
  99.     Load_Object (Cons (what, Null))
  100. #endif
  101.     ;
  102.     else
  103.     Load_Source (what);
  104.     Switch_Environment (oldenv);
  105.     GC_Unlink;
  106.     return Void;
  107. }
  108.  
  109. Object P_Load (argc, argv) Object *argv; {
  110.     return General_Load (argv[0], argc == 1 ? The_Environment : argv[1]);
  111. }
  112.  
  113. Load_Source_Port (port) Object port; {
  114.     Object val;
  115.     GC_Node;
  116.  
  117.     GC_Link (port);
  118.     while (1) {
  119.     val = General_Read (port, 1);
  120.     if (TYPE(val) == T_End_Of_File)
  121.         break;
  122.     val = Eval (val);
  123.     if (Truep (Var_Get (V_Load_Noisilyp))) {
  124.         Print (val);
  125.         (void)P_Newline (0, (Object *)0);
  126.     }
  127.     }
  128.     GC_Unlink;
  129. }
  130.  
  131. Load_Source (name) Object name; {
  132.     Object port;
  133.     GC_Node;
  134.  
  135.     port = General_Open_File (name, P_INPUT, Var_Get (V_Load_Path));
  136.     GC_Link (port);
  137.     Load_Source_Port (port);
  138.     (void)P_Close_Input_Port (port);
  139.     GC_Unlink;
  140. }
  141.